library(flexdashboard)
###
library(ggplot2)
library(plotly)
library(plyr)
library(sf)

Bar chart

Get the data
myWeb1="https://raw.githubusercontent.com/tianyl27/543_coursework_1/main/"

LifeExp_bar=readRDS(file=url(paste0(myWeb1,"plot1.rds")))
LifeExp2021 <- read.csv(file=url(paste0(myWeb1,'table1.csv')))
WHRData2021 <- read.csv(file=url(paste0(myWeb1,'WHR2021.csv')))
Plot
ggplotly(LifeExp_bar)
Error in FUN(X[[i]], ...) : object 'avg_LifeExp' not found
# title and caption text
TitleText = "Average Healthy Life Expectancy"
CaptionText = "Source: https://worldhappiness.report/ed/2021/"

# draw a picture of average life expectancy for each region
base3 = ggplot(data=LifeExp2021, aes(x=Region, y=LifeExp))+ theme_classic() + xlab("Region") + ylab("Healthy Life Expectancy") + scale_x_discrete(limits=LifeExp2021$Region)

# Get the average life expectancy for the whole world
avg_LifeExp = mean(WHRData2021$Healthy.life.expectancy)
low_regions=LifeExp2021[LifeExp2021$LifeExp<avg_LifeExp,"Region"]
low_regions
[1] "Commonwealth of Independent States" "Southeast Asia"                    
[3] "South Asia"                         "Sub-Saharan Africa"                
annotation1=paste0('World Average:',round(avg_LifeExp,2))
LifeExpMin = min(LifeExp2021$LifeExp)
LifeExpMax = max(LifeExp2021$LifeExp)
annotation2=paste0('Min:',round(LifeExpMin,2))
annotation3=paste0('Max:',round(LifeExpMax,2))


bar3 = base3 + geom_bar(stat="identity", position = "dodge", aes(fill=LifeExp<avg_LifeExp), show.legend = F)+scale_fill_manual(values=c("grey","coral")) + ylim(0,80)

# add title and caption 
bar4 = bar3 + coord_flip() + labs(title=TitleText, caption=CaptionText) + theme(plot.title = element_text(hjust = 0), plot.caption = element_text(hjust = -1))+ theme(axis.text.y = element_text(face=ifelse(LifeExp2021$Region%in%low_regions,"bold","plain")))
Warning: Vectorized input to `element_text()` is not officially supported.
Results may be unexpected or may change in future versions of ggplot2.
# add annotations
bar6 = bar4 + geom_hline(yintercept = round(avg_LifeExp,2), linetype=3, size=1, alpha=0.8)+ annotate(geom = 'text',label=annotation1,y = avg_LifeExp,x=5.5,angle=0) + annotate(geom = 'text',label=annotation2,y = LifeExpMin,x=10,angle=0) + annotate(geom = 'text',label=annotation3,y = LifeExpMax,x=1,angle=0)+theme(legend.position='none')

bar6

#ANZ: Australia and New Zealand

chart

Get the data
myWeb2="https://raw.githubusercontent.com/tianyl27/543_coursework_2/main/"
CovidDeath=readRDS(file=url(paste0(myWeb2,"CovidDeath.rds")))
Plot
ggplotly(CovidDeath)
No summary function supplied, defaulting to `mean_se()`
No summary function supplied, defaulting to `mean_se()`
GiniAge=readRDS(file=url(paste0(myWeb2,"GiniAndAge.rds")))
# ggplotly(GiniAge)
myWeb3="https://raw.githubusercontent.com/tianyl27/543_coursework_3/main/"
CountryMap=readRDS(file=url(paste0(myWeb3,"CountryMap.rds")))
ggplotly(CountryMap)
linkMap="https://github.com/EvansDataScience/VAforPM_Spatial/raw/main/worldMap.geojson" 

library(sf)
mapWorld=read_sf(linkMap)
base=ggplot(data=mapWorld) + geom_sf(fill='grey90',
                                     color=NA) + theme_classic()
WHRData2021
Map2021=readRDS(file=url(paste0(myWeb3,"mapWorldVars.rds")))
# leaflet
TitleText = "Country Performance in COVID epidemic"
CaptionText = "Source: https://worldhappiness.report/ed/2021/"
theLegTitle="World_Performance\n(grey is missing)"

clusterMap= base + geom_sf(data=Map2021,
                       aes(fill=cluster,text=NAME),
                       color=NA)
Warning: Ignoring unknown aesthetics: text
clusterMap = clusterMap+ scale_fill_brewer(palette ='BuGn',
                              direction = -1,
                              name=theLegTitle)+ labs(title=TitleText,
                                                      caption=CaptionText) +
  theme(plot.title = element_text(hjust = 1), 
        plot.caption = element_text(hjust = 0),
        axis.title.x = element_blank())
# palette ='BuGn'
# Next: change the color
# How to get rid of the axis

clusterMap%>%ggplotly()

factpal <- colorFactor(topo.colors(5), Map2021$cluster)

leaflet(Map2021) %>%addTiles() %>%
  addPolygons(fillColor = ~factpal(cluster),
              weight = 1,
              opacity = 1,
              color = "white",
              dashArray = "3",
              fillOpacity = 0.7,
              label = ~paste(NAME,": ", cluster),
              highlightOptions = highlightOptions(
                weight = 3,
                color = "#666",
                dashArray = "",
                fillOpacity = 0.7,
                bringToFront = TRUE)
              ) %>%
  addLegend("bottomright", pal = factpal, values = ~cluster,
    title = "Perfomance\n(grey is missing)",
    labFormat = labelFormat(prefix = ""),
    opacity = 1
  )
NA
NA
NA
LS0tCnRpdGxlOiAiNTQzIERhc2hib2FyZCIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQoKCmBgYHtyfQpsaWJyYXJ5KGZsZXhkYXNoYm9hcmQpCmxpYnJhcnkoZ2dwbG90MikKbGlicmFyeShwbG90bHkpCmxpYnJhcnkocGx5cikKbGlicmFyeShzZikKbGlicmFyeShsZWFmbGV0KQpsaWJyYXJ5KHJnZGFsKQoKYGBgCiMjIyMgQmFyIGNoYXJ0ICAKCiMjIyMjIEdldCB0aGUgZGF0YSAgCgpgYGB7cn0KbXlXZWIxPSJodHRwczovL3Jhdy5naXRodWJ1c2VyY29udGVudC5jb20vdGlhbnlsMjcvNTQzX2NvdXJzZXdvcmtfMS9tYWluLyIKCkxpZmVFeHBfYmFyPXJlYWRSRFMoZmlsZT11cmwocGFzdGUwKG15V2ViMSwicGxvdDEucmRzIikpKQpMaWZlRXhwMjAyMSA8LSByZWFkLmNzdihmaWxlPXVybChwYXN0ZTAobXlXZWIxLCd0YWJsZTEuY3N2JykpKQpXSFJEYXRhMjAyMSA8LSByZWFkLmNzdihmaWxlPXVybChwYXN0ZTAobXlXZWIxLCdXSFIyMDIxLmNzdicpKSkKCmBgYAoKIyMjIyMgUGxvdCAgCmBgYHtyfQpnZ3Bsb3RseShMaWZlRXhwX2JhcikKYGBgCmBgYHtyfQojIHRpdGxlIGFuZCBjYXB0aW9uIHRleHQKVGl0bGVUZXh0ID0gIkF2ZXJhZ2UgSGVhbHRoeSBMaWZlIEV4cGVjdGFuY3kiCkNhcHRpb25UZXh0ID0gIlNvdXJjZTogaHR0cHM6Ly93b3JsZGhhcHBpbmVzcy5yZXBvcnQvZWQvMjAyMS8iCgojIGRyYXcgYSBwaWN0dXJlIG9mIGF2ZXJhZ2UgbGlmZSBleHBlY3RhbmN5IGZvciBlYWNoIHJlZ2lvbgpiYXNlMyA9IGdncGxvdChkYXRhPUxpZmVFeHAyMDIxLCBhZXMoeD1SZWdpb24sIHk9TGlmZUV4cCkpKyB0aGVtZV9jbGFzc2ljKCkgKyB4bGFiKCJSZWdpb24iKSArIHlsYWIoIkhlYWx0aHkgTGlmZSBFeHBlY3RhbmN5IikgKyBzY2FsZV94X2Rpc2NyZXRlKGxpbWl0cz1MaWZlRXhwMjAyMSRSZWdpb24pCgojIEdldCB0aGUgYXZlcmFnZSBsaWZlIGV4cGVjdGFuY3kgZm9yIHRoZSB3aG9sZSB3b3JsZAphdmdfTGlmZUV4cCA9IG1lYW4oV0hSRGF0YTIwMjEkSGVhbHRoeS5saWZlLmV4cGVjdGFuY3kpCmxvd19yZWdpb25zPUxpZmVFeHAyMDIxW0xpZmVFeHAyMDIxJExpZmVFeHA8YXZnX0xpZmVFeHAsIlJlZ2lvbiJdCmxvd19yZWdpb25zCgphbm5vdGF0aW9uMT1wYXN0ZTAoJ1dvcmxkIEF2ZXJhZ2U6Jyxyb3VuZChhdmdfTGlmZUV4cCwyKSkKTGlmZUV4cE1pbiA9IG1pbihMaWZlRXhwMjAyMSRMaWZlRXhwKQpMaWZlRXhwTWF4ID0gbWF4KExpZmVFeHAyMDIxJExpZmVFeHApCmFubm90YXRpb24yPXBhc3RlMCgnTWluOicscm91bmQoTGlmZUV4cE1pbiwyKSkKYW5ub3RhdGlvbjM9cGFzdGUwKCdNYXg6Jyxyb3VuZChMaWZlRXhwTWF4LDIpKQoKCmJhcjMgPSBiYXNlMyArIGdlb21fYmFyKHN0YXQ9ImlkZW50aXR5IiwgcG9zaXRpb24gPSAiZG9kZ2UiLCBhZXMoZmlsbD1MaWZlRXhwPGF2Z19MaWZlRXhwKSwgc2hvdy5sZWdlbmQgPSBGKStzY2FsZV9maWxsX21hbnVhbCh2YWx1ZXM9YygiZ3JleSIsImNvcmFsIikpICsgeWxpbSgwLDgwKQoKIyBhZGQgdGl0bGUgYW5kIGNhcHRpb24gCmJhcjQgPSBiYXIzICsgY29vcmRfZmxpcCgpICsgbGFicyh0aXRsZT1UaXRsZVRleHQsIGNhcHRpb249Q2FwdGlvblRleHQpICsgdGhlbWUocGxvdC50aXRsZSA9IGVsZW1lbnRfdGV4dChoanVzdCA9IDApLCBwbG90LmNhcHRpb24gPSBlbGVtZW50X3RleHQoaGp1c3QgPSAtMSkpKyB0aGVtZShheGlzLnRleHQueSA9IGVsZW1lbnRfdGV4dChmYWNlPWlmZWxzZShMaWZlRXhwMjAyMSRSZWdpb24laW4lbG93X3JlZ2lvbnMsImJvbGQiLCJwbGFpbiIpKSkKCiMgYWRkIGFubm90YXRpb25zCmJhcjYgPSBiYXI0ICsgZ2VvbV9obGluZSh5aW50ZXJjZXB0ID0gcm91bmQoYXZnX0xpZmVFeHAsMiksIGxpbmV0eXBlPTMsIHNpemU9MSwgYWxwaGE9MC44KSsgYW5ub3RhdGUoZ2VvbSA9ICd0ZXh0JyxsYWJlbD1hbm5vdGF0aW9uMSx5ID0gYXZnX0xpZmVFeHAseD01LjUsYW5nbGU9MCkgKyBhbm5vdGF0ZShnZW9tID0gJ3RleHQnLGxhYmVsPWFubm90YXRpb24yLHkgPSBMaWZlRXhwTWluLHg9MTAsYW5nbGU9MCkgKyBhbm5vdGF0ZShnZW9tID0gJ3RleHQnLGxhYmVsPWFubm90YXRpb24zLHkgPSBMaWZlRXhwTWF4LHg9MSxhbmdsZT0wKSt0aGVtZShsZWdlbmQucG9zaXRpb249J25vbmUnKQoKYmFyNgojQU5aOiBBdXN0cmFsaWEgYW5kIE5ldyBaZWFsYW5kCmBgYAoKCiMjIyMgIGNoYXJ0ICAKCiMjIyMjIEdldCB0aGUgZGF0YSAgCgoKYGBge3J9Cm15V2ViMj0iaHR0cHM6Ly9yYXcuZ2l0aHVidXNlcmNvbnRlbnQuY29tL3RpYW55bDI3LzU0M19jb3Vyc2V3b3JrXzIvbWFpbi8iCkNvdmlkRGVhdGg9cmVhZFJEUyhmaWxlPXVybChwYXN0ZTAobXlXZWIyLCJDb3ZpZERlYXRoLnJkcyIpKSkKCmBgYAoKIyMjIyMgUGxvdCAgCgpgYGB7cn0KZ2dwbG90bHkoQ292aWREZWF0aCkKYGBgCmBgYHtyfQpHaW5pQWdlPXJlYWRSRFMoZmlsZT11cmwocGFzdGUwKG15V2ViMiwiR2luaUFuZEFnZS5yZHMiKSkpCiMgZ2dwbG90bHkoR2luaUFnZSkKYGBgCgoKCmBgYHtyfQpteVdlYjM9Imh0dHBzOi8vcmF3LmdpdGh1YnVzZXJjb250ZW50LmNvbS90aWFueWwyNy81NDNfY291cnNld29ya18zL21haW4vIgpDb3VudHJ5TWFwPXJlYWRSRFMoZmlsZT11cmwocGFzdGUwKG15V2ViMywiQ291bnRyeU1hcC5yZHMiKSkpCmdncGxvdGx5KENvdW50cnlNYXApCmBgYAoKYGBge3J9CmxpbmtNYXA9Imh0dHBzOi8vZ2l0aHViLmNvbS9FdmFuc0RhdGFTY2llbmNlL1ZBZm9yUE1fU3BhdGlhbC9yYXcvbWFpbi93b3JsZE1hcC5nZW9qc29uIiAKCmxpYnJhcnkoc2YpCm1hcFdvcmxkPXJlYWRfc2YobGlua01hcCkKYmFzZT1nZ3Bsb3QoZGF0YT1tYXBXb3JsZCkgKyBnZW9tX3NmKGZpbGw9J2dyZXk5MCcsCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBjb2xvcj1OQSkgKyB0aGVtZV9jbGFzc2ljKCkKCmBgYAoKYGBge3J9Ck1hcDIwMjE9cmVhZFJEUyhmaWxlPXVybChwYXN0ZTAobXlXZWIzLCJtYXBXb3JsZFZhcnMucmRzIikpKQojIGxlYWZsZXQKYGBgCgpgYGB7cn0KVGl0bGVUZXh0ID0gIkNvdW50cnkgUGVyZm9ybWFuY2UgaW4gQ09WSUQgZXBpZGVtaWMiCkNhcHRpb25UZXh0ID0gIlNvdXJjZTogaHR0cHM6Ly93b3JsZGhhcHBpbmVzcy5yZXBvcnQvZWQvMjAyMS8iCnRoZUxlZ1RpdGxlPSJXb3JsZF9QZXJmb3JtYW5jZVxuKGdyZXkgaXMgbWlzc2luZykiCgpjbHVzdGVyTWFwPSBiYXNlICsgZ2VvbV9zZihkYXRhPU1hcDIwMjEsCiAgICAgICAgICAgICAgICAgICAgICAgYWVzKGZpbGw9Y2x1c3Rlcix0ZXh0PU5BTUUpLAogICAgICAgICAgICAgICAgICAgICAgIGNvbG9yPU5BKQoKY2x1c3Rlck1hcCA9IGNsdXN0ZXJNYXArIHNjYWxlX2ZpbGxfYnJld2VyKHBhbGV0dGUgPSdCdUduJywKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgZGlyZWN0aW9uID0gLTEsCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIG5hbWU9dGhlTGVnVGl0bGUpKyBsYWJzKHRpdGxlPVRpdGxlVGV4dCwKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgY2FwdGlvbj1DYXB0aW9uVGV4dCkgKwogIHRoZW1lKHBsb3QudGl0bGUgPSBlbGVtZW50X3RleHQoaGp1c3QgPSAxKSwgCiAgICAgICAgcGxvdC5jYXB0aW9uID0gZWxlbWVudF90ZXh0KGhqdXN0ID0gMCksCiAgICAgICAgYXhpcy50aXRsZS54ID0gZWxlbWVudF9ibGFuaygpKQojIHBhbGV0dGUgPSdCdUduJwojIE5leHQ6IGNoYW5nZSB0aGUgY29sb3IKIyBIb3cgdG8gZ2V0IHJpZCBvZiB0aGUgYXhpcwoKY2x1c3Rlck1hcCU+JWdncGxvdGx5KCkKYGBgCmBgYHtyfQoKZmFjdHBhbCA8LSBjb2xvckZhY3Rvcih0b3BvLmNvbG9ycyg1KSwgTWFwMjAyMSRjbHVzdGVyKQoKbGVhZmxldChNYXAyMDIxKSAlPiVhZGRUaWxlcygpICU+JQogIGFkZFBvbHlnb25zKGZpbGxDb2xvciA9IH5mYWN0cGFsKGNsdXN0ZXIpLAogICAgICAgICAgICAgIHdlaWdodCA9IDIsCiAgICAgICAgICAgICAgb3BhY2l0eSA9IDEsCiAgICAgICAgICAgICAgY29sb3IgPSAid2hpdGUiLAogICAgICAgICAgICAgIGRhc2hBcnJheSA9ICIzIiwKICAgICAgICAgICAgICBmaWxsT3BhY2l0eSA9IDAuNywKICAgICAgICAgICAgICBsYWJlbCA9IH5wYXN0ZShOQU1FLCI6ICIsIGNsdXN0ZXIpLAogICAgICAgICAgICAgIGhpZ2hsaWdodE9wdGlvbnMgPSBoaWdobGlnaHRPcHRpb25zKAogICAgICAgICAgICAgICAgd2VpZ2h0ID0gNCwKICAgICAgICAgICAgICAgIGNvbG9yID0gIiM2NjYiLAogICAgICAgICAgICAgICAgZGFzaEFycmF5ID0gIiIsCiAgICAgICAgICAgICAgICBmaWxsT3BhY2l0eSA9IDAuNywKICAgICAgICAgICAgICAgIGJyaW5nVG9Gcm9udCA9IFRSVUUpCiAgICAgICAgICAgICAgKSAlPiUKICBhZGRMZWdlbmQoImJvdHRvbXJpZ2h0IiwgcGFsID0gZmFjdHBhbCwgdmFsdWVzID0gfmNsdXN0ZXIsCiAgICB0aXRsZSA9ICJQZXJmb21hbmNlXG4oZ3JleSBpcyBtaXNzaW5nKSIsCiAgICBsYWJGb3JtYXQgPSBsYWJlbEZvcm1hdChwcmVmaXggPSAiIiksCiAgICBvcGFjaXR5ID0gMQogICkKCgoKYGBgCgo=